home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / AMOSPRO5.DMS / in.adf / Quatro.AMOS / Quatro.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1992-09-30  |  28.0 KB  |  1,237 lines
  1. '  ********************************************
  2. '  ***                                      ***
  3. '  ***             Q U A T R O              ***
  4. '  ***                                      ***
  5. '  ***          By Dominic Ramsey           ***
  6. '  ***                                      ***
  7. '  ***     (c) 1992 Europress Software      ***
  8. '  ***                                      ***
  9. '  ********************************************
  10. '
  11. '
  12. ' First Dimension sone arrays, & make key variables global 
  13. '  
  14. Dim BD(9,9),BX(8),SC(2),BEST(9,9),OK(9,9),OMX(2),OMY(2)
  15. Global MX,MY,BD(),PLYR,BX(),SC(),QUIT,NUMPLAYERS,GAMEOVER,TEMP,TEMP2
  16. Global BEST(),OK(),LEVEL,COUNT,OMX(),OMY(),ARROW$,_FONT
  17. Close Editor 
  18. '
  19. '
  20. ' This is the main game loop 
  21. '
  22. Do 
  23.    TITLE
  24.    INIT
  25.    '
  26.    Repeat 
  27.       WHERE
  28.       If QUIT=0
  29.          CHKMVE
  30.       Else 
  31.          GAMEOVER=1
  32.       End If 
  33.       ' Has Gameover flag been set ? 
  34.    Until GAMEOVER=1
  35. Loop 
  36. '
  37. ' That's it  
  38. '
  39. '
  40. ' Game Procedures
  41. '
  42. Procedure INIT
  43.    '
  44.    ' Open game screen. Set all colours to grey
  45.    '
  46.    Unpack 7 To 0
  47.    Palette $778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778
  48.    Double Buffer : Autoback 1
  49.    '
  50.    ' Clear board  
  51.    '
  52.    GAMEOVER=0 : QUIT=0
  53.    For Y=1 To 8
  54.       For X=1 To 8
  55.          BD(X,Y)=0
  56.          BD(X,9)=3
  57.          BD(9,Y)=3
  58.       Next X
  59.    Next Y
  60.    '
  61.    Randomize Timer
  62.    '
  63.    ' Set up a simple sound envelope 
  64.    '
  65.    Set Envel 1,0 To 2,30
  66.    Set Envel 1,1 To 1,20
  67.    Set Envel 1,2 To 1,20
  68.    Set Envel 1,3 To 1,0
  69.    '
  70.    ' Set a counter to zero. This will stop the computer making the same 
  71.    ' move more than twice. This would make the game very boring.
  72.    '
  73.    COUNT=0
  74.    '
  75.    ' Place 4 Pieces in centre of board
  76.    '
  77.    BD(4,4)=1 : BD(5,5)=1
  78.    BD(4,5)=2 : BD(5,4)=2
  79.    '
  80.    For Y=4 To 5
  81.       For X=4 To 5
  82.          Paste Bob(X*20)+2,(Y*20)+2,BD(X,Y)
  83.       Next X
  84.    Next Y
  85.    Screen Copy Logic To Physic : Wait Vbl 
  86.    '
  87.    ' Co-ords of buttons 
  88.    '
  89.    BX(1)=234 : BX(2)=236 : BX(3)=243 : BX(4)=253
  90.    '
  91.    ' Set frist player to go & initial scores. 
  92.    '  
  93.    PLYR=1 : SC(1)=2 : SC(2)=2
  94.    '
  95.    ' Reserve enough screen zones for buttons & requesters 
  96.    '
  97.    Reserve Zone 6
  98.    '
  99.    ' Define the four on-screen buttons. 
  100.    '
  101.    Set Zone 1,228,100 To 296,114
  102.    Set Zone 2,228,118 To 296,132
  103.    Set Zone 3,228,136 To 296,150
  104.    Set Zone 4,228,154 To 296,168
  105.    '
  106.    ' Get correct size font  
  107.    '
  108.    Get Rom Fonts 
  109.    TEMP=1
  110.    Repeat 
  111.       TEMP$=Font$(TEMP)
  112.       If Instr(TEMP$," 8 ")>0
  113.          _FONT=TEMP
  114.       End If 
  115.       Inc TEMP
  116.    Until TEMP$=""
  117.    '
  118.    '
  119.    ' Show the board by fading to sprite palette 
  120.    '
  121.    Fade 2 To -1
  122.    Wait 30
  123.    '
  124. End Proc
  125. Procedure WHERE
  126.    '
  127.    ' This procedure decides whether it is the players turn to move, or if 
  128.    ' it should COMPUTE a move.
  129.    '
  130.    M:
  131.    '
  132.    ' Has player selected New Game?
  133.    '
  134.    If QUIT=1
  135.       Pop Proc
  136.    End If 
  137.    '
  138.    ' Clear message box & display new message. 
  139.    '
  140.    Ink 11 : Bar 220,178 To 303,194
  141.    Ink 14,11 : Set Font _FONT
  142.    If NUMPLAYERS=1 and PLYR=2
  143.       Text 230,190,"Thinking"
  144.    Else 
  145.       Paste Bob 224,179,PLYR
  146.       Text 250,190,"To Go"
  147.    End If 
  148.    '
  149.    ' Show player's scores 
  150.    '
  151.    Gr Writing 1 : Ink 12 : Text 265,68,Str$(SC(1))+" " : Text 265,85,Str$(SC(2))+" "
  152.    '
  153.    ' Copy message and score to physical screen. 
  154.    '
  155.    Screen Copy Logic To Physic : Wait Vbl 
  156.    '
  157.    ' Is it the computer's turn? 
  158.    '
  159.    If(PLYR=2 and NUMPLAYERS=1) or NUMPLAYERS=0
  160.       ' Yes it is .... 
  161.       COMPUTE
  162.    Else 
  163.       ' No it's not .... 
  164.       '
  165.       ' Wait for a valid move
  166.       '
  167.       Repeat 
  168.          MK=0 : While MK=0
  169.             MK=Mouse Key : MZ=Mouse Zone
  170.          Wend 
  171.          '
  172.          ' Check if one of the four buttons has been pressed. 
  173.          '
  174.          If MZ>0 and MZ<5 : BUTTONS : Goto M : End If 
  175.          '
  176.          ' If not, find co-oridinates of player's move
  177.          '
  178.          MY=Y Screen(Y Mouse)-21 : YS=MY
  179.          MX=X Screen(X Mouse)-21 : XS=MX
  180.          '
  181.          ' Has player clicked outside board area? 
  182.          '
  183.       Until(MY<173) and(MX<173)
  184.       '
  185.       '
  186.       ' Find the square where player clicked.
  187.       '
  188.       MX=(MX/20)+1
  189.       MY=(MY/20)+1
  190.       If XS<0 : MX=0 : End If 
  191.       If YS<0 : MY=0 : End If 
  192.    End If 
  193.    '  
  194.    '
  195.    '
  196.    '
  197. End Proc
  198. Procedure CHKMVE
  199.    '
  200.    ' Sound Effect 
  201.    '
  202.    Play 3,35+(PLYR*5),5
  203.    '
  204.    ' Check for illegal move.
  205.    '
  206.    ' Slide a row
  207.    '
  208.    DEPRESS_SLIDERS
  209.    '
  210.    '
  211.    If MX=0 or MX=9
  212.       If MY>0 and MY<9
  213.          HSLIDE : Goto ND
  214.       Else 
  215.          Goto N
  216.       End If 
  217.    End If 
  218.    '
  219.    ' Slide a column 
  220.    '
  221.    If MY=0 or MY=9
  222.       If MX>0 and MX<9
  223.          VSLIDE : Goto ND
  224.       Else 
  225.          Goto N
  226.       End If 
  227.    End If 
  228.    '
  229.    '
  230.    If BD(MX,MY)>0 Then Goto ND
  231.    '
  232.    ' Check above, below, left & right of selected move to check it is 
  233.    ' valid. The variable POSMV will be set to 1 if the move is legal. 
  234.    '
  235.    POSMV=0
  236.    '
  237.    CHU:
  238.    If MY=1 Then Goto CHD
  239.    If BD(MX,MY-1)=PLYR Then POSMV=1
  240.    '
  241.    CHD:
  242.    If MY=8 Then Goto CHL
  243.    If BD(MX,MY+1)=PLYR Then POSMV=1
  244.    '
  245.    CHL:
  246.    If MX=1 Then Goto CHR
  247.    If BD(MX-1,MY)=PLYR Then POSMV=1
  248.    '
  249.    CHR:
  250.    If MX=8 Then Goto N
  251.    If BD(MX+1,MY)=PLYR Then POSMV=1
  252.    '
  253.    N:
  254.    '
  255.    ' Is move Invalid? 
  256.    '
  257.    If POSMV=0 Then INVALID : Goto ND
  258.    '
  259.    ' All checks complete, move is valid. Paste players piece onto board.
  260.    '
  261.       Paste Bob(MX*20)+2,(MY*20)+2,PLYR : Wait Vbl 
  262.    '
  263.    ' Update board array 
  264.    '
  265.    BD(MX,MY)=PLYR
  266.    '
  267.    ' Increase player's score  
  268.    '
  269.    Inc SC(PLYR)
  270.    '
  271.    ' Change player
  272.    '
  273.    If PLYR=1 Then PLYR=2 Else PLYR=1
  274.    '
  275.    ND:
  276.    '
  277.    ' If computer has moved, move pointer back to mouse position.  
  278.    '
  279.    If(NUMPLAYERS=1 and PLYR=1) or NUMPLAYERS=0
  280.       Wait 10
  281.       Amal 1,"Let R0=XM-RA ; Let R1= YM-RB ;  Move R0,R1,20 ;"
  282.       Amal On 1
  283.    End If 
  284.    '
  285.    ' Check board for a 4 square. If found, remove pieces from the board.  
  286.    '
  287.    For TEMP=1 To 7
  288.       For TEMP2=1 To 7
  289.          For CHECK=1 To 2
  290.             If BD(TEMP,TEMP2)=CHECK and BD(TEMP+1,TEMP2)=CHECK and BD(TEMP,TEMP2+1)=CHECK and BD(TEMP+1,TEMP2+1)=CHECK
  291.                ' Play a sound effect
  292.                For MUS=24 To 48 : Play 12,MUS,1 : Next 
  293.                ' Remove pieces from board 
  294.                Paste Bob TEMP*20,TEMP2*20,10 : Paste Bob(TEMP+1)*20,TEMP2*20,10
  295.                Paste Bob TEMP*20,(TEMP2+1)*20,10 : Paste Bob(TEMP+1)*20,(TEMP2+1)*20,10
  296.                ' Update board array 
  297.                BD(TEMP,TEMP2)=0 : BD(TEMP+1,TEMP2)=0 : BD(TEMP,TEMP2+1)=0 : BD(TEMP+1,TEMP2+1)=0
  298.                ' Decrease player's score
  299.                Add SC(CHECK),-4
  300.             End If 
  301.          Next CHECK
  302.       Next TEMP2
  303.    Next TEMP
  304.    '
  305.    ' Reset pointer to move with mouse 
  306.    '
  307.    Wait 20
  308.    Amal 1,ARROW$
  309.    Amal On 1
  310.    '
  311.    ' Check for a winner 
  312.    '
  313.    CHECKWINNER
  314.    '
  315. End Proc
  316. Procedure BUTTONS
  317.    ' Quatro jumps to this procedure when one of the buttons on the right
  318.    ' hand panel is pressed. 
  319.    '
  320.    ' Play a note
  321.    '
  322.    Play 30,0
  323.    '
  324.    ' Find which button was pressed. 
  325.    MZ=Mouse Zone
  326.    '
  327.    ' Get button as a compacted block. 
  328.    '
  329.    Get Cblock 1,228,81+(19*MZ),76,15
  330.    '
  331.    ' Replace button with depressed version stored in the Bob bank.  
  332.    '
  333.    ' First erase the background 
  334.    Ink 11
  335.    Bar 230,82+(19*MZ) To 294,93+(19*MZ)
  336.    Paste Bob BX(MZ),82+(19*MZ),MZ+4
  337.    '
  338.    ' Copy to physical screen. 
  339.    '
  340.    Screen Copy Logic To Physic : Wait Vbl 
  341.    '
  342.    ' Wait for player to let go of left mouse button.
  343.    '
  344.    While Mouse Key=1 : Wend 
  345.    '  
  346.    ' Wait, then replace with original image 
  347.    '
  348.    Wait 10
  349.    Put Cblock 1 : Del Cblock 1
  350.    Screen Copy Logic To Physic : Wait Vbl 
  351.    '
  352.    ' Now take appropriate action
  353.    '
  354.    If MZ=4 Then Edit 
  355.    On MZ Proc INST,NW_GAME,CREDITS
  356.    '
  357. End Proc
  358. Procedure CHK_BUTTONS
  359.    '
  360.    ' Simple button checking routine for detecting button presses while
  361.    ' computer is `thinking'.
  362.    '
  363.    If Mouse Key=1
  364.       If Mouse Zone>0 and Mouse Zone<5
  365.          BUTTONS
  366.       End If 
  367.    End If 
  368. End Proc
  369. Procedure INVALID
  370.    Bell 
  371.    Get Cblock 1,99,69,220,130
  372.    Ink 8,
  373.    Bar 100,70 To 219,129
  374.    Ink 1,
  375.    Box 100,70 To 219,129
  376.    Ink 14,
  377.    Box 101,71 To 218,128
  378.    Ink 1,8 : Set Font _FONT
  379.    Text 130,85,"Invalid"
  380.    Text 135,95," Move"
  381.    Ink 12,8
  382.    Text 128,110,"Click To"
  383.    Text 128,120,"Continue"
  384.    Screen Copy Logic To Physic
  385.    While Mouse Key<>1
  386.    Wend 
  387.    Put Cblock 1
  388.    Screen Copy Logic To Physic
  389.    Wait Vbl 
  390. End Proc
  391. Procedure HSLIDE
  392.    If PLYR=1 Then PLYR=2 Else PLYR=1
  393.    Screen Open 1,210,20,16,Lowres : Flash Off : Get Palette 0
  394.    Screen Hide 1
  395.    If MX=0
  396.       Screen Copy 0,20,(MY*20),40,(MY*20)+20 To 1,160,0
  397.       Screen Copy 0,20,MY*20,180,MY*20+20 To 1,0,0
  398.       For X=1 To 20
  399.          Play 3,X/2+10,0
  400.          Screen Copy 1,X,0,160+X,20 To 0,20,MY*20
  401.          Screen Swap : Wait Vbl 
  402.       Next 
  403.       TMP=BD(1,MY)
  404.       For A=2 To 8
  405.          BD(A-1,MY)=BD(A,MY)
  406.       Next 
  407.       BD(8,MY)=TMP
  408.    Else 
  409.       Screen Copy 0,160,(MY*20),180,(MY*20)+20 To 1,0,0
  410.       Screen Copy 0,20,MY*20,180,MY*20+20 To 1,20,0
  411.       For X=20 To 0 Step -1
  412.          Play 3,X/2+11,0
  413.          Screen Copy 1,X,0,160+X,20 To 0,20,MY*20
  414.          Screen Swap : Wait Vbl 
  415.       Next X
  416.       TMP=BD(8,MY)
  417.       For A=7 To 1 Step -1
  418.          BD(A+1,MY)=BD(A,MY)
  419.       Next A
  420.       BD(1,MY)=TMP
  421.    End If 
  422.    Screen Copy Physic(0) To Logic(0)
  423.    Screen Close 1
  424.    Clip 
  425. End Proc
  426. Procedure VSLIDE
  427.    If PLYR=1 Then PLYR=2 Else PLYR=1
  428.    Screen Open 1,100,200,16,Lowres : Flash Off 
  429.    Screen Hide 1
  430.    Screen 0
  431.    If MY=0
  432.       Screen Copy 0,MX*20,20,MX*20+20,200 To 1,0,0
  433.       Screen Copy 0,MX*20,20,MX*20+20,40 To 1,0,160
  434.       For Y=1 To 20
  435.          Play 3,Y/2+10,0
  436.          Screen Copy 1,0,Y,20,160+Y To 0,MX*20,20
  437.          Screen Swap : Wait Vbl 
  438.       Next 
  439.       TMP=BD(MX,1)
  440.       For A=2 To 8
  441.          BD(MX,A-1)=BD(MX,A)
  442.       Next 
  443.       BD(MX,8)=TMP
  444.    Else 
  445.       Screen Copy 0,MX*20,20,MX*20+20,200 To 1,0,20
  446.       Screen Copy 0,MX*20,160,MX*20+20,180 To 1,0,0
  447.       For Y=20 To 0 Step -1
  448.          Play 3,Y/2+11,0
  449.          Screen Copy 1,0,Y,20,160+Y To 0,MX*20,20
  450.          Screen Swap : Wait Vbl 
  451.       Next 
  452.       TMP=BD(MX,8)
  453.       For A=7 To 1 Step -1
  454.          BD(MX,A+1)=BD(MX,A)
  455.       Next A
  456.       BD(MX,1)=TMP
  457.    End If 
  458.    Screen Copy Physic(0) To Logic(0)
  459.    Screen Close 1
  460.    Clip 
  461. End Proc
  462. Procedure CREDITS
  463.    Get Cblock 1,85,35,164,133
  464.    Ink 0
  465.    Bar 85,37 To 235,167
  466.    Ink 1
  467.    Box 85,37 To 235,167
  468.    Ink 14
  469.    Box 86,38 To 234,166
  470.    Screen Copy 0,203,0,320,36 To 0,103,41
  471.    Ink 14,0 : Set Font _FONT
  472.    Text 115,88,"Programming"
  473.    Text 111,98,"And Graphics"
  474.    Ink 1
  475.    Text 114,110," D. Ramsey"
  476.    Ink 14,0
  477.    Text 114,126,"Game Design"
  478.    Ink 1,
  479.    Text 114,138," D. Ramsey"
  480.    Text 114,148," C. Ramsey"
  481.    Ink 7,
  482.    Text 94,162,"Click To Continue"
  483.    Screen Copy Logic To Physic
  484.    While Mouse Key<>1
  485.    Wend 
  486.    Put Cblock 1 : Del Cblock 
  487.    Screen Copy Logic To Physic
  488.    Wait Vbl 
  489. End Proc
  490. Procedure CHECKWINNER
  491.    If SC(1)=0 or SC(2)=0 Then NDGAME : Pop Proc
  492. End Proc
  493. Procedure DEPRESS_SLIDERS
  494.    '
  495.    ' Depress slide buttons
  496.    '
  497.    If MY=0
  498.       ' left 
  499.       Bob 2,(MX*20),MY*20+2,17 : Update 
  500.       Wait 15
  501.       Bob Off 2 : Update : Wait Vbl 
  502.    End If 
  503.    '
  504.    '
  505.    If MY=9
  506.       ' left 
  507.       Bob 2,(MX*20),(MY*20),20 : Update 
  508.       Wait 15
  509.       Bob Off 2 : Update : Wait Vbl 
  510.    End If 
  511.    '
  512.    '
  513.    If MX=9
  514.       ' left 
  515.       Bob 2,(MX*20),(MY*20),19 : Update 
  516.       Wait 15
  517.       Bob Off 2 : Update : Wait Vbl 
  518.    End If 
  519.    '
  520.    '
  521.    If MX=0
  522.       ' left 
  523.       Bob 2,(MX*20)+2,(MY*20),18 : Update 
  524.       Wait 15
  525.       Bob Off 2 : Update : Wait Vbl 
  526.    End If 
  527.    '
  528. End Proc
  529. Procedure NDGAME
  530.    '
  531.    ' Display a simple Game Over message.
  532.    '
  533.    Ink 0
  534.    Bar 85,37 To 235,167
  535.    Ink 1
  536.    Box 85,37 To 235,167
  537.    Ink 14 : Set Font _FONT
  538.    Box 86,38 To 234,166
  539.    Screen Copy 0,203,0,320,36 To 0,103,41 : Ink 12,0
  540.    Text 120,100," Game Over"
  541.    Screen Copy Logic To Physic : Wait Vbl 
  542.    '
  543.    ' Do a very simple Anim. 
  544.    '
  545.    Channel 1 To Bob 1 : Bob 1,330,100,1
  546.    If SC(1)=0 Then TEMP=1 : Anim 1,"(1,10)(11,10)L"
  547.    If SC(2)=0 Then TEMP=2 : Anim 1,"(2,10)(12,10)L"
  548.    ' Who one? 
  549.    If SC(1)=SC(2) Then Text 110,120," Match Drawn!" : Goto NND
  550.    Bob 1,155,110,TEMP : Anim On 
  551.    Text 145,140,"Wins!"
  552.    '
  553.    ' Copy to physical screen. 
  554.    '
  555.    NND: Screen Copy Logic To Physic
  556.    '
  557.    ' Play a simple sound effect 
  558.    '
  559.    For TEMP=12 To 24
  560.       Play 3,TEMP,4
  561.       Play 12,TEMP+12,4
  562.    Next TEMP
  563.    For TEMP=1 To 5
  564.       Play 3,24,4
  565.       Play 12,36,4
  566.    Next TEMP
  567.    '
  568.    ' Wait for mouse key 
  569.    '
  570.    While Mouse Key=0 : Wend 
  571.    '
  572.    ' Set Game Over flag.
  573.    GAMEOVER=1
  574.    '
  575.    ' Fade out game screen.
  576.    '
  577.    Fade 2,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778
  578.    Wait 30
  579.    '
  580. End Proc
  581. Procedure NW_GAME
  582.    '
  583.    ' Display a `New Game?' requester. 
  584.    '
  585.    ' First get background as a compacted block. 
  586.    '
  587.    Get Cblock 2,85,45,164,154
  588.    '
  589.    ' Draw requester 
  590.    '
  591.    Ink 0
  592.    Bar 85,45 To 235,165
  593.    Ink 1
  594.    Box 85,45 To 235,165
  595.    Ink 14,0 : Set Font _FONT
  596.    Box 86,46 To 234,164
  597.    Text 100,60,"Are you sure you"
  598.    Text 105,70," want to start"
  599.    Text 105,80,"  a new game?"
  600.    Locate 0,13
  601.    '
  602.    ' The following few lines set 2 screen zones around the text. Zones number 
  603.    ' 5 and 6 are used so as not to affect existing zones 1-4. 
  604.    '
  605.    Centre Border$(Zone$(" Yes Please ",5),2)
  606.    Locate 0,17
  607.    Centre Border$(Zone$("No, carry on",6),2)
  608.    '
  609.    ' Copy requetser to physical screen. 
  610.    '
  611.    Screen Copy Logic To Physic : Wait Vbl 
  612.    '
  613.    ' Wait for a selection.
  614.    '
  615.    Repeat 
  616.       While Mouse Key<>1
  617.       Wend 
  618.       M=Mouse Zone
  619.    Until M>4 and M<7
  620.    '
  621.    If M=5
  622.       ' Set Quit flag
  623.       QUIT=1
  624.       Fade 2,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778
  625.       Wait 30
  626.    Else QUIT=0
  627.    End If 
  628.    '
  629.    ' Put the old background back. Delete the CBlock to save memory. 
  630.    '
  631.    Put Cblock 2 : Del Cblock 2
  632.    '
  633.    ' Copy to physical screen. 
  634.    '
  635.    Screen Copy Logic To Physic : Wait Vbl 
  636. End Proc
  637. Procedure INST
  638.    '
  639.    ' This procedure shows the instruction screen, which is simply a packed
  640.    ' IFF screen in bank 8.
  641.    '
  642.    ' Unpack and hide instruction screen. Set all colours to grey. 
  643.    Unpack 8 To 1 : Screen To Back 1
  644.    Palette $778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778
  645.    '
  646.    ' Fade out game screen to the same colour grey 
  647.    '
  648.    Screen 0
  649.    Fade 2,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778
  650.    Wait 30
  651.    '
  652.    ' Bring instruction screen to front, and fade colours to sprite
  653.    ' palette  [ Fade 2 To -1 ]. 
  654.    '
  655.    Screen To Front 1
  656.    Screen 1
  657.    Fade 2 To -1
  658.    Wait 30
  659.    '
  660.    ' Wait for user to hit left mouse button, then fade out instruction  
  661.    ' screen & close the screen. 
  662.    '
  663.    While Mouse Key<>1 : Wend 
  664.    Fade 2,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778
  665.    Wait 30
  666.    Screen Close 1
  667.    '
  668.    ' Fade game screen back into view
  669.    '
  670.    Screen 0
  671.    Fade 2 To -1
  672.    Wait 30
  673. End Proc
  674. Procedure TITLE
  675.    '
  676.    ' Unpack title screen & a spare screen with same dimensions
  677.    ' and colours. Picture will copied bit by bit from the hidden screen 
  678.    ' into view. 
  679.    '
  680.    Unpack 6 To 2 : Screen Hide 2
  681.    Unpack 6 To 0 : Cls 0 : Colour Back $778
  682.    Music 1 : Led Off : Tempo 28 : Mvolume 63
  683.    '
  684.    ' Hide pointer 
  685.    Hide On 
  686.    '
  687.    ' Set colour cycling of last 16 colours in palette.  
  688.    '
  689.    Shift Up 1,16,31,1
  690.    '
  691.    For X=0 To 159 Step 20
  692.       For Y=0 To 200 Step 10
  693.          Wait Vbl 
  694.          Screen Copy 2,X,Y,X+20,Y+10 To 0,X,Y
  695.          Screen Copy 2,300-X,Y,320-X,Y+10 To 0,300-X,Y
  696.       Next Y
  697.    Next X
  698.    '
  699.    ' Close spare screen 
  700.    '
  701.    Screen Close 2
  702.    '
  703.    ' Set sprite as mouse pointer  
  704.    '
  705.    ' Set AMAL channel 1 to mouse pointer
  706.    Channel 1 To Sprite 1
  707.    ARROW$="L: Let X=XM ; Let Y=YM; Jump L"
  708.    Sprite 1,1,1,3 : Amal 1,ARROW$
  709.    '
  710.    ' Switch on AMAL 
  711.    '
  712.    Amal On 
  713.    '
  714.    ' Limit mouse to screen area 
  715.    Wait Vbl : Limit Mouse X Hard(0),Y Hard(0) To X Hard(307),Y Hard(187)
  716.    '
  717.    ' Set up screen zones for menu 
  718.    '
  719.    Reserve Zone 4
  720.    Set Zone 1,86,67 To 239,89
  721.    Set Zone 2,86,92 To 239,114
  722.    Set Zone 3,86,117 To 239,139
  723.    Set Zone 4,86,142 To 239,164
  724.    '
  725.    ' Wait for a selection 
  726.    '
  727.    Repeat 
  728.       While Mouse Key<>1 : Wend 
  729.       MZ=Mouse Zone
  730.    Until MZ>0 and MZ<5
  731.    '
  732.    If MZ=1
  733.       ' Demo mode
  734.       NUMPLAYERS=0
  735.       LEVEL=2
  736.    Else If MZ=2
  737.          ' 2 players
  738.          NUMPLAYERS=2
  739.       Else 
  740.          ' 1 player, level 1 or 2 
  741.          NUMPLAYERS=1
  742.          LEVEL=MZ-2
  743.       End If 
  744.    End If 
  745.    '
  746.    ' Fade out title screen
  747.    '
  748.    Fade 2,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778,$778
  749.    For V=60 To 0 Step -2 : Mvolume V : Wait Vbl : Next V
  750.    '
  751.    ' Close title screen 
  752.    '
  753.    Screen Close 0
  754. End Proc
  755. '
  756. ' Move computation procedures
  757. '
  758. Procedure COMPUTE
  759.    '
  760.    ' This is where the computer decides on it's move in a one player game.
  761.    ' There are many ways you could do this in a board game, but in Quatro,
  762.    ' the computer goes through every sqaure on the board, and checks for
  763.    ' certain patterns of pieces. It then gives that square a `score'
  764.    ' depending on how desirable it would be for the computer to move  
  765.    ' there. After it has been through every possible move, it simply looks  
  766.    ' for the move with the highest score, checks that it's a legal move,
  767.    ' then makes it's move.
  768.    '
  769.    ' Clear old values for best move 
  770.    '
  771.    MX=0 : MY=0 : Rem  These hold co-ords of move. 
  772.    For X=0 To 9
  773.       For Y=0 To 9
  774.          BEST(X,Y)=0
  775.          OK(X,Y)=0
  776.       Next Y
  777.    Next X
  778.    '
  779.    ' Go through each square on the board and give it a 'score'
  780.    ' The computer will go for the square with the highest score. [BEST()] 
  781.    '
  782.    For X=1 To 8
  783.       For Y=1 To 8
  784.          '
  785.          ' Has player pressed a button ?
  786.          '
  787.          CHK_BUTTONS
  788.          If QUIT=1
  789.             Pop Proc
  790.          End If 
  791.          '
  792.          ' Check for various patterns of pieces 
  793.          '
  794.          If(LEVEL=2) or(LEVEL=1 and Rnd(2)<2)
  795.             CHECKSQ[1,X,Y]
  796.          End If 
  797.          CHECKSQ[2,X,Y]
  798.          CHKSINGLE[X,Y]
  799.          If LEVEL=2
  800.             CHK_ADVANCED[X,Y]
  801.          End If 
  802.       Next Y
  803.    Next X
  804.    '
  805.    ' SHW_BOARD
  806.    '
  807.    ' Make the move. Best move position is returned in the variables MX and MY.
  808.    '
  809.    MAKEMOVE
  810.    '
  811.    ' Just in case computer doesn't find a move (very rare), slide a column. 
  812.    '
  813.    If MX=0 and MY=0
  814.       MX=5 : MY=9
  815.    End If 
  816.    '  
  817.    ' Move Pointer to square 
  818.    '
  819.    Amal Off 
  820.    '  
  821.    ' Set External AMAL registers to X & Y co-ords of move.
  822.    '
  823.    Amreg(0)=X Hard((MX*20)+5)
  824.    Amreg(1)=Y Hard((MY*20)+5)
  825.    Amal 1,"Let R0=RA-XM ; Let R1=RB-YM ;  Move R0,R1,20 ;"
  826.    Amal On 1
  827.    Wait 35
  828. End Proc
  829. Procedure CHECKSQ[P,PX,PY]
  830.    '
  831.    ' Reset 2 temporary variables, then check two squares at position PX,PY  
  832.    ' to see if they are both red or green.  
  833.    '
  834.    TEMP=0 : TEMP2=0
  835.    ' Then check row below, to see if computer can form a square 
  836.    CHKHORIZ[P,PX,PY]
  837.    TEMP=Param
  838.    CHKHORIZ[P,PX,PY+1]
  839.    TEMP2=Param
  840.    '
  841.    ' Variables TEMP & TEMP2 contain 0,1,2 or 3 depending on how many pieces 
  842.    ' match then colour P. (P=1 for player 1, etc...)
  843.    '
  844.    ' S=Score for forming a square.
  845.    '  
  846.    ' Higher for Player 1, as it is more important for computer to block 
  847.    ' opponents squares than make it's own.
  848.    '
  849.    S=8-(P*2)
  850.    If P=PLYR Then S2=-3 Else S2=5
  851.    '
  852.    If(TEMP=2) and(TEMP2=3)
  853.       If PX<8
  854.          Add BEST(PX+2,PY+1),4
  855.       End If 
  856.       If PY<8
  857.          Add BEST(PX,PY+2),4
  858.       End If 
  859.       Add BEST(PX,PY),S
  860.       Add BEST(9,PY),S2
  861.       Add BEST(0,PY+1),S2
  862.       Add BEST(PX,9),S2
  863.       Add BEST(PX+1,0),S2
  864.    End If 
  865.    '  
  866.    '
  867.    If(TEMP=1) and(TEMP2=3)
  868.       If PX>1
  869.          Add BEST(PX-1,PY),4
  870.       End If 
  871.       If PY<8
  872.          Add BEST(PX+1,PY+2),4
  873.       End If 
  874.       Add BEST(PX+1,PY),S
  875.       Add BEST(0,PY),S2
  876.       Add BEST(9,PY+1),S2
  877.       Add BEST(PX,0),S2
  878.       Add BEST(PX+1,9),S2
  879.    End If 
  880.    '
  881.    '
  882.    If(TEMP=3) and(TEMP2=2)
  883.       If PY>1
  884.          Add BEST(PX,PY-1),4
  885.       End If 
  886.       If PX<8
  887.          Add BEST(PX+2,PY+1),4
  888.       End If 
  889.       Add BEST(PX,PY+1),S
  890.       Add BEST(0,PY),S2
  891.       Add BEST(9,PY+1),S2
  892.       Add BEST(PX,0),S2
  893.       Add BEST(PX+1,9),S2
  894.    End If 
  895.    '  
  896.    '
  897.    If(TEMP=3) and(TEMP2=1)
  898.       If PY>1
  899.          Add BEST(PX+1,PY-1),4
  900.       End If 
  901.       If PX>1
  902.          Add BEST(PX-1,PY+1),4
  903.       End If 
  904.       Add BEST(PX+1,PY+1),S
  905.       Add BEST(9,PY),S2
  906.       Add BEST(0,PY+1),S2
  907.       Add BEST(PX,9),S2
  908.       Add BEST(PX+1,0),S2
  909.    End If 
  910.    '
  911.    '
  912.    ' If computer has only two pices in a row, increase score for that   
  913.    ' square by a smaller amount. This way, the computer will choose the   
  914.    ' best move possible.
  915.    '
  916.    If TEMP=3 and TEMP2=0
  917.       ' Increase score of 2 squares below  
  918.       Add BEST(PX,PY+1),2
  919.       Add BEST(PX+1,PY+1),2
  920.       ' Increase score of 2 squares above  
  921.       Add BEST(PX,PY-1),2
  922.       Add BEST(PX+1,PY-1),2
  923.    End If 
  924.    '
  925.    ' Computer has two pieces vertically 
  926.    '
  927.    If TEMP=1 and TEMP2=1
  928.       ' Increase score of 2 sqaures to right 
  929.       Add BEST(PX+1,PY),2
  930.       Add BEST(PX+1,PY+1),2
  931.       ' Increase score of 2 sqaures to left  
  932.       Add BEST(PX-1,PY),2
  933.       Add BEST(PX-1,PY+1),2
  934.    End If 
  935.    '
  936.    ' Pieces in a  OO    or   OO  shape    
  937.    '               OO       OO
  938.    '
  939.    ' computer should slide row PY to the left  or right         
  940.    '
  941.    ' Slide row one way for player 1's pieces, the opposite way for computer's.  
  942.    '
  943.    S=1+(NUMPLAYERS*6)
  944.    '
  945.    If TEMP=3 and PX<8
  946.       ' Check if computer can make a square
  947.       CHKHORIZ[P,PX+1,PY+1] : TEMP=Param
  948.       If TEMP=3
  949.          If P=PLYR
  950.             Add BEST(9,PY),S
  951.             Add BEST(0,PY+1),S
  952.          Else 
  953.             Add BEST(0,PY),S
  954.             Add BEST(9,PY+1),S
  955.          End If 
  956.       End If 
  957.       CHKHORIZ[P,PX-1,PY+1] : TEMP=Param
  958.       If TEMP=3
  959.          If P=PLYR
  960.             Add BEST(0,PY),S
  961.          Else 
  962.             Add BEST(9,PY),S
  963.          End If 
  964.       End If 
  965.       '  
  966.    End If 
  967.    '
  968.    If LEVEL=2
  969.       ' Check for    O      O
  970.       '             OO and  OO    shapes.
  971.       '             O        O 
  972.       '
  973.       CHKVERT[P,PX,PY] : TEMP=Param
  974.       If TEMP=3 and PY<8
  975.          '
  976.          CHKVERT[P,PX+1,PY+1] : TEMP=Param
  977.          If TEMP=3
  978.             If P=PLYR
  979.                Add BEST(PX,9),S
  980.             Else 
  981.                Add BEST(PX,0),S
  982.             End If 
  983.          End If 
  984.          CHKVERT[P,PX-1,PY+1] : TEMP=Param
  985.          If TEMP=3
  986.             If P=PLYR
  987.                Add BEST(PX,9),S
  988.             Else 
  989.                Add BEST(PX,0),S
  990.             End If 
  991.          End If 
  992.          '  
  993.       End If 
  994.    End If 
  995. End Proc
  996. Procedure CHKHORIZ[P,PX,PY]
  997.    CHECK=0
  998.    If PY>8 Then Pop Proc
  999.    If BD(PX,PY)=P
  1000.       Inc CHECK
  1001.    End If 
  1002.    '
  1003.    ' If end of board is reached, check the piece at the beginning of the row, 
  1004.    ' as these pieces are effectively next to each other.
  1005.    '
  1006.    If PX<8
  1007.       If BD(PX+1,PY)=P
  1008.          Add CHECK,2
  1009.       End If 
  1010.    Else 
  1011.          If BD(1,PY)=P
  1012.             Add CHECK,2
  1013.          End If 
  1014.       End If 
  1015.    'Return a param of 1,2 or 3 depending on how many pieces match p 
  1016. End Proc[CHECK]
  1017. Procedure CHKVERT[P,PX,PY]
  1018.    CHECK=0
  1019.    '   If PY<8
  1020.    If BD(PX,PY)=P
  1021.       Inc CHECK
  1022.    End If 
  1023.    '   End If 
  1024.    '
  1025.    ' If end of board is reached, check the piece at the beginning of the row, 
  1026.    ' as these pieces are effectively next to each other.
  1027.    '
  1028.    If PY<8
  1029.       If BD(PX,PY+1)=P
  1030.          Add CHECK,2
  1031.       End If 
  1032.    Else 
  1033.          If BD(PX,1)=P
  1034.             Add CHECK,2
  1035.          End If 
  1036.       End If 
  1037.    'Return a param of 1,2 or 3 depending on how many pieces match p 
  1038. End Proc[CHECK]
  1039. Procedure CHKSINGLE[PX,PY]
  1040.    If PX>1
  1041.       If BD(PX-1,PY)=PLYR
  1042.          Inc BEST(PX,PY)
  1043.          OK(PX,PY)=1
  1044.       End If 
  1045.    End If 
  1046.    '
  1047.    If PY>1
  1048.       If BD(PX,PY-1)=PLYR
  1049.          Inc BEST(PX,PY)
  1050.          OK(PX,PY)=1
  1051.       End If 
  1052.    End If 
  1053.    '
  1054.    If PX<8
  1055.       If BD(PX+1,PY)=PLYR
  1056.          Inc BEST(PX,PY)
  1057.          OK(PX,PY)=1
  1058.       End If 
  1059.    End If 
  1060.    '
  1061.    If PY<8
  1062.       If BD(PX,PY+1)=PLYR
  1063.          Inc BEST(PX,PY)
  1064.          OK(PX,PY)=1
  1065.       End If 
  1066.    End If 
  1067.    '
  1068. End Proc
  1069. Procedure MAKEMOVE
  1070.    '
  1071.    ' In this procedure, the computer will find it's best move, and set
  1072.    ' the variables MX and MY to the co-ordinates of that move.
  1073.    '
  1074.    THINK:
  1075.    BEST=0
  1076.    For X=0 To 9
  1077.       For Y=0 To 9
  1078.          If BEST(X,Y)>BEST
  1079.             If BD(X,Y)<1 or BD(X,Y)>2
  1080.                '
  1081.                If X>0 and X<9 and Y>0 and Y<9
  1082.                   If OK(X,Y)=1
  1083.                      ' Best move so far 
  1084.                      BEST=BEST(X,Y)
  1085.                      MX=X
  1086.                      MY=Y
  1087.                   End If 
  1088.                Else 
  1089.                   'A sliding move
  1090.                   If(X=Y) or(X=0 and Y=9) or(X=9 and Y=0)
  1091.                      ' Can't go in the corners, as it's not possible to 
  1092.                      ' slide a row and a column 
  1093.                      ' at the same time.
  1094.                   Else 
  1095.                      BEST=BEST(X,Y)
  1096.                      MX=X
  1097.                      MY=Y
  1098.                   End If 
  1099.                End If 
  1100.             End If 
  1101.          End If 
  1102.       Next Y
  1103.    Next X
  1104.    '
  1105.    ' Has computer made same move again? 
  1106.    '
  1107.    If OMX(PLYR)=MX and OMY(PLYR)=MY
  1108.       ' Increase counter. Computer should not make the same move 
  1109.       ' three times in a row 
  1110.       Inc COUNT
  1111.    Else 
  1112.       COUNT=0
  1113.    End If 
  1114.    '
  1115.    ' Computer is more persistent on higher level
  1116.    '
  1117.    If COUNT=LEVEL
  1118.       BEST(MX,MY)=0
  1119.       COUNT=0
  1120.       Goto THINK
  1121.    End If 
  1122.    '
  1123.    '
  1124.    ' Randomize movement in Demo Mode and easy level.
  1125.    '
  1126.    If(NUMPLAYERS=0) or(LEVEL=1)
  1127.       If((MX=0 or MX=9) and MY=8 and Rnd(1)=0)
  1128.          BEST(MX,MY)=1
  1129.          COUNT=0
  1130.          Goto THINK
  1131.       End If 
  1132.    End If 
  1133.    '
  1134.    ' Store computer's last move 
  1135.    '
  1136.    OMX(PLYR)=MX
  1137.    OMY(PLYR)=MY
  1138. End Proc
  1139. Procedure SHW_BOARD
  1140.    '
  1141.    ' This is a small procedure I wrote, to see where the computer thought 
  1142.    ' the best moves were. It is not actually used in the game, but you can
  1143.    ' see what it does if you remove the apostrophe (') from the line
  1144.    '  
  1145.    '             ' SHW_BOARD  
  1146.    '
  1147.    ' in the COMPUTE procedure.
  1148.    '
  1149.    ' When you play the game, the `score' given to each square will be 
  1150.    ' displayed at the top of the screen before the computer makes it's move.
  1151.    ' The higher the number, the more the computer wants to make a particular
  1152.    ' move. No account is taken of whether or not a particular move is   
  1153.    ' legal, as this is done in the MAKEMOVE procedure.
  1154.    '
  1155.    Locate 0,0
  1156.    For Y=0 To 9
  1157.       For X=0 To 9
  1158.          Print BEST(X,Y);
  1159.       Next X
  1160.       Print 
  1161.    Next Y
  1162. End Proc
  1163. Procedure CHK_ADVANCED[PX,PY]
  1164.    '
  1165.    ' This procedure is only called on level 3, the hard level. It checks for
  1166.    ' more advanced patterns that might enable the computer to form a square 
  1167.    ' in two moves time. This will be the only time when the computer `thinks
  1168.    ' ahead'.
  1169.    '
  1170.    ' These are the patterns of pieces on the board that the computer will 
  1171.    ' search for : - 
  1172.    '        1           2           3          4
  1173.    '       OO          OO           O          O  
  1174.    '         OO      OO             O          O  
  1175.    '                                 O        O 
  1176.    '                                 O        O 
  1177.    '  
  1178.    ' This should be enough to make the computer a pretty good player.   
  1179.    ' Remember, the computer will not `miss' any patterns as a human player    
  1180.    ' might. 
  1181.    ' If you want, you can add more search patterns at the end of this 
  1182.    ' procedure. 
  1183.    '
  1184.    TEMP=0 : TEMP2=0
  1185.    '
  1186.    ' Pattern 1
  1187.    '
  1188.    CHKHORIZ[PLYR,PX,PY]
  1189.    TEMP=Param
  1190.    If PX<7
  1191.       CHKHORIZ[PLYR,PX+2,PY+1]
  1192.       TEMP2=Param
  1193.    End If 
  1194.    '
  1195.    If TEMP=3 and TEMP2=3
  1196.       Add BEST(9,PY),3
  1197.       Add BEST(0,PY+1),3
  1198.    End If 
  1199.    '
  1200.    ' Pattern 2
  1201.    '
  1202.    If PX>1
  1203.       CHKHORIZ[PLYR,PX-2,PY+1]
  1204.       TEMP2=Param
  1205.       If TEMP=3 and TEMP2=3
  1206.          Add BEST(0,PY),3
  1207.          Add BEST(9,PY+1),3
  1208.       End If 
  1209.    End If 
  1210.    TEMP=0 : TEMP2=0
  1211.    '
  1212.    ' Pattern 3
  1213.    '
  1214.    CHKVERT[PLYR,PX,PY]
  1215.    TEMP=Param
  1216.    If PY<7
  1217.       CHKVERT[PLYR,PX+1,PY+2]
  1218.       TEMP2=Param
  1219.    End If 
  1220.    '
  1221.    If TEMP=3 and TEMP2=3
  1222.       Add BEST(PX,9),3
  1223.       Add BEST(PX+1,0),3
  1224.    End If 
  1225.    '
  1226.    ' Pattern 4
  1227.    '
  1228.    If PY>1
  1229.       CHKVERT[PLYR,PX+1,PY-2]
  1230.       TEMP2=Param
  1231.       If TEMP=3 and TEMP2=3
  1232.          Add BEST(PX,0),3
  1233.          Add BEST(PX+1,9),3
  1234.       End If 
  1235.    End If 
  1236.    '  
  1237. End Proc